home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
DELPHI32
/
SYS_TOOL
/
MULTI020
/
MULTI020.ZIP
/
MULTI.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-09-06
|
8KB
|
196 lines
{$S-}
{$DEFINE DEBUG}
unit Multi;
{ Multi 0.1 beta, A Unit For Cooperative Multitasking }
interface
{#T Multitasking-Introduction}
{ A short introduction to MULTI
Please do yourself a favour and read the manual. I know that most of
us hate to read manuals, and I hate to write them, so it is rather
short, and contains not much overhead (except that annoying constant
praising of myself, of course ;) )
A Task is basically a far procedure which takes one untyped VAR
parameter. If anyone calls #Switch#, a different task (if any) is
invoked. If DEBUG is $DEFINEd, each task has a pointer to a string
containing an ID which can be dumped to the monochrome monitor.
Create a task with #Fork#. If the task procedure exits or calls
#Terminate#, it is killed and no Switch will reach it again. Each
task has its own stack and can have local variables.
Fork returns a task pointer which can be used to terminate the other
task or to make it wait for a #Semaphore#. Tasks waiting for a semaphore
are not reached by Switch until the semaphore (basically a list of
the waiting tasks or NIL if no tasks are waiting) is #Release#d or
commits #Kamikaze#.
If a task needs to de-initialize something, it should set #tTask.HasExit#
TRUE, it will then be called if the program terminates and the task
is still active. Or if a semaphore is killed and the task waits for
that semaphore. In that case Switch will return TRUE, the task has to
de-initialize and kill itself immediately. }
{$IFDEF DEBUG}
uses dual, nconv;
{$ENDIF}
{$IFDEF DEBUG}
const
debug : boolean = true;
{#X debugdump Dump}
{ If TRUE, these messages may be printed to the monochrome monitor :
[Taskname] terminated
[Taskname] created
[Taskname] put asleep
this means the task waits for a semaphore now.
[Taskname] release
[Taskname] poisoned
[Taskname] Halt of RunError
Only available if DEBUG is $DEFINEd. }
debugdump : boolean = false;
{#X debug}
{ If TRUE, sometimes debug dumps will be printed to the monochrome
monitor. See #Dump# for an example dump.
Only available if DEBUG is $DEFINEd. }
{$ENDIF}
type
TaskProc = procedure (var v);
{ Template for task procedures. Any procedure you want to be a task
must look like this and they must be FAR. }
pTask = ^tTask;
tTask = record
{ tTask describes a task to MULTI. }
CSIP : pointer;
{ CSIP points to the instruction where the execution
of this task continues. You could kill a task by
letting CSIP point to Terminate, but it can't deinit
then. Use #Poisoned# instead }
Stack : pointer;
{ Stack points to the first word of the stack of the task.
Don't change this pointer, or MULTI won't be able to free
the stack if the task terminates }
sp : word;
{ This is the Stack Pointer CPU register of that task.
Don't alter this value ! }
bp : word;
{ This is the Base Pointer CPU register of that task.
Don't alter this value ! }
StackSize : word;
{ This is the number of bytes allocated for the stack of
the task, don't alter this value ! }
Poisoned,
{#X Kamikaze Waitfor}
{ If set to TRUE, the task will be terminated soon.
If #HasExit# is also TRUE, the task will be given the
chance to deinitialize itself, otherwise #Switch# will
never return to this task.
This can be used to terminate a task from outside. A
task can kill itself by calling #Terminate#. }
HasExit : boolean;
{ If set to TRUE, and the task is #Poisoned#, too,
#Switch# will not just cancel the task but it will
Return TRUE to the task. The task has to deinitialize
and Terminate then. }
l,
{ 'Last' pointer; the tasks in the execution queue #t# and
in #Semaphore# queues are doubly linked with this and #r#. }
n : pTask;
{ 'Next' pointer; the tasks in the execution queue #t# and
in #Semaphore# queues are doubly linked with this and #l#. }
{$IFDEF DEBUG}
s : ^String;
{#X debug debugdump Dump}
{ Pointer to the name of the task as printed to the monochrome
monitor as debugging information are displayed.
This member is only available if DEBUG is $DEFINEd. }
{$ENDIF}
end;
Semaphore = pTask;
{#X InitSemaphore WaitFor Release Kamikaze}
{ A semaphore is simply a pointer to a task. The task can be linked to
other tasks, too (via #tTask.l# and #tTask.n#), which makes up a
doubly linked list. Semaphores must be initalized with #InitSemaphore#. }
const
t : pTask = nil;
{ This is a pointer to the currently active task. Via #tTask.l# and
#tTask.n# the task is linked to other tasks producing a ring queue
of active tasks (i.e. tasks #Switch# could execute if called). }
function Fork(p : TaskProc; SSize : word; var v {$IFDEF DEBUG}; const tname : string {$ENDIF}) : pTask;
{ p is the procedure you want Fork to execute as a task.
SSize is the size of the stack to assign to the new task.
v is a pointer to pass to the task (or #Nothing# if you want to pass nothing)
tname is the name of the task, for debugging dumps }
function Switch : boolean;
{ Switch to the next active task.
If another task sets #tTask.Poisoned#, and #tTask.HasExit# is FALSE,
Switch does not return from here, but the task is killed instead.
If #tTask.HasExit# is TRUE, Switch will return #tTask.Poisoned#, and
when Switch returns TRUE, the task should deinitialize and terminate
as soon as possible. }
{$IFDEF DEBUG}
procedure Dump;
{#X debug debugdump}
{ Dumps a list of the active tasks (i.e. the tasks Switch may execute
if it is called. This is an example dump :
CS:IP = 1234:5678, SS:SP = 5678:1234 [HasExit] "Main"
CS:IP = 8763:5187, SS:SP = 9876:5432 [Poisoned] "KbdIn"
1 of 4 allocated semaphores:
1234:5678 }
{$ENDIF}
procedure Terminate;
{ Terminates the calling task. Terminate does not return !
If the last active task terminates, and there are no #Semaphore#s,
Terminate halts the program. If there are semaphores, Terminate
waits for an interrupt to #Release# one.
To terminate another task, set it's #tTask.Poisoned# flag.
To terminate all tasks waiting for a semaphore, use #Kamikaze# }
procedure InitSemaphore(var s : Semaphore);
{ Initialize semaphore as "no tasks are waiting" }
function WaitFor(var a : tTask; var s : Semaphore) : boolean;
{ Waitfor makes a wait for s to be #Release#d.
Use 't^' as 'a' to make the current task wait.
Waitfor returns when :
* s is #Release#d. WaitFor returns FALSE.
* s is #Kamikaze#d and #tTask.HasExit# is TRUE.
WaitFor returns TRUE. Deinitialize and #Terminate#
immediately. }
procedure Release(var s : Semaphore);
{#X Kamikaze}
{ All waiting tasks are inserted in the queue of active
tasks; the next #Switch# can execute them again, their
#WaitFor# will return FALSE. }
function Kamikaze(var s : Semaphore) : boolean;
{#X Release}
{ All waiting tasks get their #tTask.Poisoned# set to TRUE.
Then they are inserted in the queue of active tasks; when
#Switch# comes to execute them, it will
* #Terminate# them if #tTask.HasExit# is FALSE.
Execution of that task is not resumed again.
* Execute it; their #WaitFor# will return TRUE.
Kamikaze can be executed on the queue of active tasks #t#, too.
This will terminate this task, too, or return TRUE if
tTask.HasExit is TRUE. }
const Nothing : byte = 0;
{#X Fork}
{ Use Fork(Task,2048,Nothing) if no parameter is desired }
implementation